home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.02 Feb 88 / pascal sources / Plot Project Stuff / myFileStuff < prev    next >
Encoding:
Text File  |  1988-01-07  |  6.3 KB  |  255 lines  |  [TEXT/PJMM]
  1. UNIT MyFileStuff;
  2.  
  3. INTERFACE
  4.  
  5.     USES
  6.         ROM85, PrintTraps, PlotGlobals, Misc;
  7.  
  8.     PROCEDURE doSaveAs;
  9.     PROCEDURE doSave;
  10.  
  11. IMPLEMENTATION
  12.  
  13.     PROCEDURE doSaveAs;
  14.         LABEL
  15.             1, 2;
  16.         CONST
  17.             SFPutLeft = 82;
  18.             SFPutTop = 50;
  19.             headerBytes = 512;
  20.         TYPE
  21.             DrawHeader = RECORD
  22.                     fill : ARRAY[1..256] OF integer;
  23.                 END;
  24.         VAR
  25.             SFPutPt : Point;
  26.             theReply : SFReply;
  27.             err : OSErr;
  28.             refNum : Integer;
  29.             bytes : LongInt;
  30.             myWindow : WindowPtr;
  31.             title : str255;
  32.             myType : OSType;
  33.             myCreator : OSType;
  34.             str1, str2 : str255;
  35.             header : DrawHeader;
  36.             i : integer;
  37.             myPicture : PicHandle;
  38.             PicLength : LongInt;
  39.     BEGIN
  40.         myPicture := PlotDocHandle^^.Drawing;
  41.         IF myPicture = NIL THEN
  42.             doMessage('No picture to save yet!', '', '', '')
  43.         ELSE
  44.             BEGIN
  45.                 SetPt(SFPutPt, SFPutLeft, SFPutTop);
  46.                 WITH header DO
  47.                     BEGIN
  48.                         FOR i := 1 TO headerBytes DIV 2 DO {512 bytes}
  49.                             fill[i] := 0;
  50.                     END;
  51.                 bytes := headerBytes;
  52.                 myWindow := PlotWindow;
  53.                 GetWTitle(myWindow, title);
  54.                 SFPutFile(SFPutPt, 'Save Plot as…', title, NIL, theReply);
  55.                 IF theReply.good THEN
  56.                     BEGIN
  57.                         myType := 'PICT';
  58.                         myCreator := 'MDRW'; {MacDraw doc}
  59.                         err := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
  60.                         IF err <> noErr THEN
  61.                             BEGIN
  62.                                 IF err = dupFNErr THEN
  63.                                     BEGIN
  64.                                         err := FSDelete(theReply.fname, theReply.vRefNum);
  65.                                         IF err <> noErr THEN
  66.                                             BEGIN
  67.                                                 doMessage('Cannot delete duplicate file.', '', '', '');
  68.                                                 GOTO 1;
  69.                                             END;
  70.                                         err := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
  71.                                         IF err <> noErr THEN
  72.                                             BEGIN
  73.                                                 doMessage('Cannot create file...', '', '', '');
  74.                                                 GOTO 1;
  75.                                             END;
  76.                                     END
  77.                                 ELSE
  78.                                     BEGIN
  79.                                         doMessage('Cannot create new file...', '', '', '');
  80.                                         GOTO 1;
  81.                                     END;
  82.                             END;
  83.                         err := FSOpen(theReply.fname, theReply.vRefNum, refNum);
  84.                         IF err <> noErr THEN
  85.                             BEGIN
  86.                                 doMessage('Cannot open file...', '', '', '');
  87.                                 GOTO 1;
  88.                             END;
  89.                         err := SetFPos(refNum, FSFromStart, 0);
  90.                         IF err <> noErr THEN
  91.                             BEGIN
  92.                                 doMessage('Cannot set start of file...', '', '', '');
  93.                                 GOTO 2;
  94.                             END;
  95.  
  96.                         err := FSWrite(refNum, bytes, @header);
  97.                         IF err <> noErr THEN
  98.                             BEGIN
  99.                                 doMessage('Cannot write header to file...', '', '', '');
  100.                                 GOTO 2;
  101.                             END;
  102.                         IF bytes <> 512 THEN
  103.                             BEGIN
  104.                                 NumToString(bytes, str1);
  105.                                 str1 := concat(str1, ' bytes');
  106.                                 str2 := concat('out of ', '512');
  107.                                 doMessage('Only able to write ', str1, str2, 'to file.');
  108.                                 GOTO 2;
  109.                             END;
  110.                         PicLength := GetHandleSize(Handle(DrawingPic));
  111.                         bytes := PicLength;
  112.                         err := FSWrite(refNum, bytes, pointer(DrawingPic^));
  113.                         IF err <> noErr THEN
  114.                             BEGIN
  115.                                 doMessage('Cannot write picture to file...', '', '', '');
  116.                                 GOTO 2;
  117.                             END;
  118.                         IF bytes <> PicLength THEN
  119.                             BEGIN
  120.                                 NumToString(bytes, str1);
  121.                                 str1 := concat(str1, ' bytes');
  122.                                 NumToString(PicLength, str2);
  123.                                 str2 := concat('out of ', str2);
  124.                                 doMessage('Only able to write ', str1, str2, 'to file.');
  125.                                 GOTO 2;
  126.                             END;
  127.                         SetWTitle(myWindow, theReply.fname);
  128.                         PlotDocHandle^^.FileName := theReply.fname;
  129.                         PlotDocHandle^^.VolRefNum := theReply.vRefNum;
  130.                         EnableItem(myMenus[FileM], fSave);
  131. 2 :
  132.                         err := FSClose(refNum);
  133.                         IF err <> noErr THEN
  134.                             BEGIN
  135.                                 doMessage('Cannot close file...', '', '', '');
  136.                                 ExitToShell;
  137.                             END;
  138.                         err := FlushVol(NIL, theReply.vRefNum);
  139.                         IF err <> NoErr THEN
  140.                             BEGIN
  141.                                 doMessage('Cannot flush volume...', '', '', '');
  142.                                 ExitToShell;
  143.                             END;
  144. 1 :
  145.                         SetCursor(arrow);
  146.                     END; {if good}
  147.             END; {else pic exits}
  148.     END;{ of proc}
  149.  
  150.     PROCEDURE doSave;
  151.         LABEL
  152.             1, 2;
  153.         CONST
  154.             headerBytes = 512;
  155.         TYPE
  156.             DrawHeader = RECORD
  157.                     fill : ARRAY[1..256] OF integer;
  158.                 END;
  159.         VAR
  160.             err : OSErr;
  161.             refNum : Integer;
  162.             bytes : LongInt;
  163.             myWindow : WindowPtr;
  164.             title : str255;
  165.             str1, str2 : str255;
  166.             header : DrawHeader;
  167.             i : integer;
  168.             myPicture : PicHandle;
  169.             PicLength : LongInt;
  170.             myRefNum : integer;
  171.             myFname : str255;
  172.     BEGIN
  173.         myPicture := PlotDocHandle^^.Drawing;
  174.         IF myPicture = NIL THEN
  175.             doMessage('No picture to save yet!', '', '', '')
  176.         ELSE
  177.             BEGIN
  178.                 myRefNum := PlotDocHandle^^.VolRefNum;
  179.                 myFname := PlotDocHandle^^.FileName;
  180.                 IF myRefNum = 0 THEN
  181.                     BEGIN
  182.                         doMessage('Cannot save file', 'Use SaveAs...', '', '');
  183.                         GOTO 1;
  184.                     END;
  185.  
  186.                 WITH header DO
  187.                     BEGIN
  188.                         FOR i := 1 TO headerBytes DIV 2 DO {512 bytes}
  189.                             fill[i] := 0;
  190.                     END;
  191.                 bytes := headerBytes;
  192.  
  193.                 err := FSOpen(myFname, myRefNum, refNum);
  194.                 IF err <> noErr THEN
  195.                     BEGIN
  196.                         doMessage('Cannot open file...', '', '', '');
  197.                         GOTO 1;
  198.                     END;
  199.                 err := SetFPos(refNum, FSFromStart, 0);
  200.                 IF err <> noErr THEN
  201.                     BEGIN
  202.                         doMessage('Cannot set start of file...', '', '', '');
  203.                         GOTO 2;
  204.                     END;
  205.  
  206.                 err := FSWrite(refNum, bytes, @header);
  207.                 IF err <> noErr THEN
  208.                     BEGIN
  209.                         doMessage('Cannot write header to file...', '', '', '');
  210.                         GOTO 2;
  211.                     END;
  212.                 IF bytes <> 512 THEN
  213.                     BEGIN
  214.                         NumToString(bytes, str1);
  215.                         str1 := concat(str1, ' bytes');
  216.                         str2 := concat('out of ', '512');
  217.                         doMessage('Only able to write ', str1, str2, 'to file.');
  218.                         GOTO 2;
  219.                     END;
  220.                 PicLength := GetHandleSize(Handle(DrawingPic));
  221.                 bytes := PicLength;
  222.                 err := FSWrite(refNum, bytes, pointer(DrawingPic^));
  223.                 IF err <> noErr THEN
  224.                     BEGIN
  225.                         doMessage('Cannot write picture to file...', '', '', '');
  226.                         GOTO 2;
  227.                     END;
  228.                 IF bytes <> PicLength THEN
  229.                     BEGIN
  230.                         NumToString(bytes, str1);
  231.                         str1 := concat(str1, ' bytes');
  232.                         NumToString(PicLength, str2);
  233.                         str2 := concat('out of ', str2);
  234.                         doMessage('Only able to write ', str1, str2, 'to file.');
  235.                         GOTO 2;
  236.                     END;
  237. 2 :
  238.                 err := FSClose(refNum);
  239.                 IF err <> noErr THEN
  240.                     BEGIN
  241.                         doMessage('Cannot close file...', '', '', '');
  242.                         ExitToShell;
  243.                     END;
  244.                 err := FlushVol(NIL, myRefNum);
  245.                 IF err <> NoErr THEN
  246.                     BEGIN
  247.                         doMessage('Cannot flush volume...', '', '', '');
  248.                         ExitToShell;
  249.                     END;
  250. 1 :
  251.                 SetCursor(arrow);
  252.             END; {if good}
  253.     END;{ of proc}
  254.  
  255. END.